
#include "../basic/operator.h"

/* make closure. c is code. e is environment */
//创建闭包
Cell* make_closure(Scheme *sc, Cell* code, Cell* env) {
	Cell* p = make_cell(sc, code, env);
	// (p)->_flag = T_CLOSURE;
	(p)->_type = CLOSURE_TYPE;
	return p;
}

// (make-closure closure)
Cell* op_make_closure(Scheme *sc) {
	Cell *x, *y;

	//形式1 (make-clourse '(lambda? var-name body ...) envir?)      lambda 和 envir是可有可无的
	//形式2 (make-clourse '(lambda? (var-name ...) body ...) envir?)      lambda 和 envir是可有可无的
	//例子 (define f (make-closure '(plus ((car plus) 3 4))))  结果为7
	x = car(sc->args);
	if (car(x) == cell_lambda)
		x = cdr(x);
	if (cdr(sc->args) == G_NIL)
		y = sc->env;
	else
		y = cadr(sc->args);
	sc->returnValue = make_closure(sc, x, y);
	return pop_callstack(sc);
}

// (get-closure-code closure)
Cell* op_get_closure(Scheme *sc) {
	sc->args = first(sc->args);
	TYPE_CHECK(sc, sc->args, CLOSURE_TYPE);
	sc->returnValue = cons(sc, cell_lambda, car(sc->args));
	return pop_callstack(sc);
}

/*
// (get-closure-code closure)
Cell* op_get_closure(Scheme *sc) {
	sc->args = first(sc->args);
	if (sc->args == G_NIL) {
		return s_return_helper(sc, G_FALSE);
	} else if (type_of(sc->args, CLOSURE_TYPE)) {
		return s_return_helper(sc, cons(sc, sc->sym_lambda, car(sc->args)));
		//s_return_helper(sc, cons(sc, sc->sym_lambda, closure_code(sc->args)));
	} else {
		return s_return_helper(sc, G_FALSE);
	}
}
*/

void init_closure_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "make-closure", make_closure);
	ADD_OPERATOR(sc, "get-closure-code", get_closure);
}
